home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / schmlbrr / schem_lb.lha / unsupported / CScheme / log-oper.scm < prev    next >
Encoding:
Text File  |  1991-08-05  |  3.3 KB  |  149 lines
  1. ;;; -*- Base: 10; Mode: Scheme; Syntax: MIT Scheme; Package: USER -*-
  2. ;;
  3. ;; LOG-OPER.SCM
  4. ;;
  5. ;; June 29, 1991
  6. ;; Minghsun Liu
  7. ;;
  8. ;; This file contains some logical operations that are not provided by
  9. ;; MIT Scheme but implemented in CL.
  10. ;;
  11. ;;
  12. ;; The following(s) are(is) defined:
  13. ;;
  14. ;; *MAX-BIT-STRING-LENGTH*
  15. ;; (I-LIST->B-LIST ORIGINAL-LIST)
  16. ;; (LOGIOR N ...)
  17. ;; (LOGAND N ...)
  18. ;; (SI->BS N)
  19. ;; (LOGANDC2 N1 N2)
  20. ;; (INTEGER-LENGTH N)
  21. ;; (ASH N COUNT)
  22. ;; (LOGCOUNT N)
  23. ;;
  24. (declare (usual-integrations))
  25.  
  26.  
  27. ;;
  28. ;; *MAX-BIT-STRING-LENGTH*
  29. ;;
  30. ;; determines the maximum length of bit-string to create when
  31. ;; converting from decimal representation of integers.
  32. ;;
  33. (define *max-bit-string-length* 200)
  34.  
  35.  
  36. ;;
  37. ;; (I-LIST->B-LIST ORIGINAL-LIST)
  38. ;;
  39. ;; returns a list of bitstrings converted from the elements in the
  40. ;; list ORIGNAL-LIST which are signed integers.
  41. ;;
  42. (define (i-list->b-list original-list)
  43.   (map si->bs original-list))
  44.  
  45.  
  46. ;;
  47. ;; (LOGIOR N ..)
  48. ;;
  49. ;; returns the bitwise logical 'inclusive or' of its arguments.  0 is
  50. ;; the identity for this function.
  51. ;;
  52. (define (logior #!rest args)
  53.   (define (logior-aux aux-args)
  54.     (if (null? (cdr aux-args))
  55.         (car aux-args)
  56.         (bit-string-or (car aux-args) (logior-aux (cdr aux-args)))))
  57.   (if (null? args)
  58.       0
  59.       (bit-string->signed-integer (logior-aux (i-list->b-list
  60.                            args)))))
  61.  
  62.  
  63. ;;
  64. ;; (LOGAND N ...)
  65. ;;
  66. ;; returns the bitwise logical `and' or its arguments.  -1 is the
  67. ;; identity of this function.
  68. ;;
  69. (define (logand #!rest args)
  70.   (define (logand-aux aux-args)
  71.     (if (null? (cdr aux-args))
  72.         (car aux-args)
  73.         (bit-string-and (car aux-args) (logand-aux (cdr aux-args)))))
  74.   (if (null? args)
  75.       -1
  76.       (bit-string->signed-integer (logand-aux (i-list->b-list
  77.                            args)))))
  78.  
  79. ;;
  80. ;; (SI->BS N)
  81. ;;
  82. ;; converts N into a newly allocated bit string of length
  83. ;; *max-bit-string-length*, a global variable.
  84. ;;
  85. (define (si->bs n)
  86.   (signed-integer->bit-string *max-bit-string-length* n))
  87.  
  88.  
  89. ;;
  90. ;; (LOGANDC2 N1 N2)
  91. ;;
  92. ;; returns the bitwise logical `and' of N1 and the complement of N2.
  93. ;;
  94. (define (logandc2 b1 b2)
  95.   (bit-string->signed-integer
  96.    (bit-string-andc (si->bs b1) (si->bs b2))))
  97.  
  98.  
  99. ;;
  100. ;; (INTEGER-LENGTH N)
  101. ;;
  102. ;; get number of bits required to store the absolute magnitude of a
  103. ;; given integer N.
  104. ;;
  105. (define (integer-length n)
  106.   (let ((leng
  107.      (inexact->exact (ceiling (/ (log (if (< n 0)
  108.                           (- n)
  109.                           (1+ n)))
  110.                      (log 2))))))
  111.     (if (= (expt 2 (-1+ leng)) (1+ n))
  112.     (-1+ leng)  ;; correction needed - a little fudging to fix the round-off error
  113.     leng)))
  114.     
  115.  
  116. ;;
  117. ;; (ASH N COUNT)
  118. ;;
  119. ;; returns an integer representing the integer N shifted COUNT bits to
  120. ;; the left or right, depending if COUNT is positive or negative.  For
  121. ;; now, this is done using arithmetic to simulate the logical
  122. ;; operations and is expensive.  Further benchmark needed.
  123. ;;
  124. (define (ash n count)
  125.   (floor (* n (expt 2 count))))
  126.     
  127.  
  128. ;;
  129. ;; (LOGCOUNT N)
  130. ;;
  131. ;; counts the number of 1 or 0 bits in an integer, depending if the
  132. ;; integer is positive or negative.
  133. ;;
  134. (define (logcount n)
  135.   (let* ((count-one #t)
  136.          (result 0)
  137.          (bs-size (1+ (integer-length n)))
  138.          (bin-rep (signed-integer->bit-string bs-size n)))
  139.     (if (> 0 n)
  140.         (set! count-one #f))
  141.     (do ((i 0 (1+ i)))
  142.         ((= i bs-size) result)
  143.       (if (eq? (bit-string-ref bin-rep i) count-one)
  144.           (set! result (1+ result))))))
  145.  
  146.  
  147.  
  148.  
  149.